home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / tobject / ObjectArrayUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-03-23  |  3.3 KB  |  130 lines
  1. unit ObjectArrayUnit;
  2.  
  3. interface
  4.  
  5. type
  6.   TTinyName = string[3];
  7.   TTinyObject = class(TObject)
  8.   private
  9.     FValue: integer;
  10.     FName: TTinyName;
  11.   public
  12.     property Value: integer read FValue write FValue;
  13.     property Name: TTinyName read FName write FName;
  14.   end;
  15.  
  16.   TFastTinyObject = class(TTinyObject)
  17.   public
  18.     class procedure InitObjectStore(Count: Cardinal);
  19.     class procedure FreeObjectStore;
  20.     class function NewInstance: TObject; override;
  21.     procedure FreeInstance; override;
  22.   end;
  23.  
  24.   TFasterTinyObject = class(TFastTinyObject)
  25.   public
  26.     class function NewInstance: TObject; override;
  27.     procedure FreeInstance; override;
  28.   end;
  29.  
  30. implementation
  31.  
  32. uses SysUtils, Classes;
  33.  
  34. type
  35.   TObjectStore = class(TObject)
  36.   private
  37.     FMemoryPool: PChar;
  38.     FPoolSize: Cardinal;
  39.     FAllocatedCount: Cardinal;
  40.     FCurrentFree: PChar;
  41.   public
  42.     constructor Create(PoolSize: Cardinal);
  43.     destructor Destroy; override;
  44.     function AllocateInstance(InstanceSize: Cardinal): TObject;
  45.     procedure DeallocateInstance(InstanceSize: Cardinal);
  46.   end;
  47.  
  48. { TObjectStore }
  49.  
  50. constructor TObjectStore.Create(PoolSize: Cardinal);
  51. begin
  52.   inherited Create;
  53.   FPoolSize := PoolSize;
  54.   GetMem(FMemoryPool, FPoolSize);
  55.   FCurrentFree := FMemoryPool;
  56. end;
  57.  
  58. destructor TObjectStore.Destroy;
  59. begin
  60.   if FAllocatedCount <> 0 then
  61.     raise Exception.Create('References into the ObjectStore has not been released!');
  62.   FreeMem(FMemoryPool, FPoolSize);
  63.   inherited Destroy;
  64. end;
  65.  
  66. function TObjectStore.AllocateInstance(InstanceSize: Cardinal): TObject;
  67. begin
  68.   if Self = nil then
  69.     raise Exception.Create('Objectstore has not been allocated yet.');
  70.   Result := TObject(FCurrentFree);
  71.   Inc(FCurrentFree, InstanceSize);
  72.   if Longint(FMemoryPool) + FPoolSize < Longint(FCurrentFree) then
  73.     raise Exception.Create('Not enough space allocated in objectstore to allocate instance');
  74.   Inc(FAllocatedCount);
  75. end;
  76.  
  77. procedure TObjectStore.DeallocateInstance(InstanceSize: Cardinal);
  78. begin
  79.   if Self = nil then
  80.     raise Exception.Create('Objectstore has not been allocated yet.');
  81.   if FAllocatedCount = 0 then
  82.     raise Exception.Create('Deallcated more instances from the objectstore than was allocated');
  83.   Dec(FAllocatedCount);
  84. end;
  85.  
  86. { TFastTinyObject }
  87.  
  88. const
  89.   FTinyObjectStore: TObjectStore = nil;
  90.  
  91. class procedure TFastTinyObject.InitObjectStore(Count: Cardinal);
  92. begin
  93.   FTinyObjectStore := TObjectStore.Create(Count * Self.InstanceSize);
  94. end;
  95.  
  96. class procedure TFastTinyObject.FreeObjectStore;
  97. begin
  98.   FTinyObjectStore.Free;
  99.   FTinyObjectStore := nil;
  100. end;
  101.  
  102. class function TFastTinyObject.NewInstance: TObject;
  103. begin
  104.   Result := FTinyObjectStore.AllocateInstance(Self.InstanceSize);
  105.   Result := InitInstance(Result);
  106. end;
  107.  
  108. procedure TFastTinyObject.FreeInstance;
  109. begin
  110.   FTinyObjectStore.DeallocateInstance(Self.InstanceSize);
  111. end;
  112.  
  113. { TFasterTinyObject }
  114.  
  115. class function TFasterTinyObject.NewInstance: TObject;
  116. type
  117.   PClass = ^TClass;
  118. begin
  119.   Result := TObject(FTinyObjectStore.FCurrentFree);
  120.   Inc(FTinyObjectStore.FCurrentFree, SizeOf(TFastTinyObject));
  121.   PClass(Result)^ := Self;  // Init VMT, don't init fields.
  122. end;
  123.  
  124. procedure TFasterTinyObject.FreeInstance;
  125. begin
  126. // Do nothing!
  127. end;
  128.  
  129. end.
  130.